home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 025a / gsdb25.zip / GS_DBTBL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-01  |  9KB  |  358 lines
  1. UNIT GS_DBTbl;
  2.  
  3. {-----------------------------------------------------------------------------
  4. Changes:
  5.  
  6.         7 Apr 91 - Modified Build_dBTabl to insert the 'APPEND' at the
  7.                    end of the table, if applicable.  This was previously
  8.                    done in Pick_dBTabl, which caused Build_dBTabl to miss
  9.                    doing this if called separately.
  10.  
  11.                    Modified Find_dBTabl and FindNext_dBTabl to avoid testing
  12.                    the 'APPEND' entry (if there).  A test on the 'APPEND'
  13.                    entry can cause a match against a blank field if there
  14.                    are sufficient leading spaces in the 'APPEND' entry.
  15.  
  16.         1 Aug 91 - Added SortAsnd flag to determine direction of table sort.
  17.                    Default is ascending sort;
  18.  
  19. ------------------------------------------------------------------------------}
  20.  
  21.  
  22. INTERFACE
  23.  
  24. USES
  25.    Crt,
  26.    Dos,
  27.    GS_Error,
  28.    GS_KeyI,
  29.    GS_dBase,
  30.    GS_Winfc,
  31.    GS_Pick,
  32.    GS_Strng;
  33.  
  34.  
  35. type
  36.  
  37.  
  38.    dBTabl_Arry_Fld = array [0..MaxInt] of byte;
  39.    dBTabl_Pick_Obj = Object
  40.                       dbas     : ^GS_dBase_DB;      {Object to refer to}
  41.                       Pick_Win : GS_Wind_Objt;      {Window object for menu}
  42.                       Tabl     : ^dBTabl_Arry_Fld;  {Menu table on the heap}
  43.                       Sz_Tab   : longint;           {Size of table}
  44.                       siz      : integer;           {Size of a table entry}
  45.                       recs     : longint;           {Number records in table}
  46.                       Sel_Item : longint;           {Last entry number selected}
  47.                       Scn_Key  : string;            {Holds select key formula}
  48.                       AddRecOk : boolean;           {True allows appending}
  49.                       AddRec   : boolean;           {True if append selected}
  50.                       SortAsnd : boolean;           {True if ascending sort}
  51.  
  52.                       procedure Append_dbTabl(tf : boolean);
  53.                       procedure Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
  54.                                      x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
  55.                       procedure Reset_dBTabl;
  56.                       procedure Build_dBTabl(zfld : string);
  57.                       function  Choose_dBTabl : boolean;
  58.                       function  Pick_dBTabl(zfld : string) : boolean;
  59.                       function  Find_dBTabl(pcnd : string) : boolean;
  60.                       function  FindNext_dBTabl(pcnd : string) : boolean;
  61.                       function  Scan_dBTabl(pfld, pcnd, zfld : string)
  62.                                                              : boolean;
  63.                    end;
  64.  
  65.  
  66. implementation
  67.  
  68.  
  69. var
  70.    File_Win     :  GS_Wind_Objt;
  71.    ap           :  string[10];
  72.  
  73.  
  74. procedure dBTabl_Pick_Obj.Append_dBTabl(tf : boolean);
  75. begin
  76.    AddRecOK := tf;
  77.    AddRec := false;
  78.    Reset_dBTabl;
  79. end;
  80.  
  81.  
  82.  
  83. procedure dBTabl_Pick_Obj.Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
  84.                                       x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
  85. begin
  86.    ap := '- APPEND -';
  87.    dBas := @Fil;
  88.    Tabl := nil;
  89.    Pick_Win.InitWin(x1,y1,x2,y2,tx,bg,tx,itx,ibg,true,stg,true);
  90.    Scn_Key := '^^^^';
  91.    Sel_Item := 1;
  92.    AddRecOK := false;
  93.    AddRec := false;
  94.    SortAsnd := true;
  95. end;
  96.  
  97. procedure dBTabl_Pick_Obj.Reset_dBTabl;
  98. begin
  99.    if Tabl <> nil then FreeMem(Tabl,Sz_Tab);
  100.    Tabl := nil;
  101.    Scn_Key := '^^^^';
  102.    Sel_Item := 1;
  103. end;
  104.  
  105. procedure dBTabl_Pick_Obj.Build_dBTabl(zfld : string);
  106. var
  107.    l : longint;
  108.    t : string[127];
  109.    ia : boolean;
  110.    v  : integer;
  111.    ta : byte;
  112.    ft : char;
  113. begin
  114.    Reset_dBTabl;
  115.    zfld := AllCaps(zfld);
  116.    Scn_Key := zfld;
  117.    with dBas^ do
  118.    begin
  119.       ia := dbfNdxActv;
  120.       dbfNdxActv := false;         {Temporarily turn off any index}
  121.       GetRec(Top_Record);
  122.       t := Formula(zfld,ft);
  123.       l := 0;
  124.       recs := dBas^.NumRecs;
  125.       if AddRecOK then inc(recs);
  126.       siz := length(t) + 5;
  127.       Sz_Tab := recs * siz;
  128.       GetMem(Tabl,Sz_Tab);
  129.       while (not File_EOF) do
  130.       begin
  131.          t := Formula(zfld,ft);
  132.          move(t,Tabl^[l*siz],siz-4);
  133.          move(RecNumber,Tabl^[(l*siz)+siz-4],4);
  134.          inc(l);
  135.          GetRec(Next_Record);
  136.       end;
  137.       dbfNdxActv := ia;
  138.       GetRec(Top_Record);          {Puts DBF and NDX back in sync}
  139.       recs := l;
  140.       GS_Pick_Item_Sort(Tabl^,siz,recs,SortAsnd);
  141.       if AddRecOK then
  142.       begin
  143.          inc(recs);
  144.          v := siz-5;
  145.          FillChar(t[1],v,' ');
  146.          t[0] := chr(v);
  147.          Insert(ap,t,succ((v - 10) div 2));
  148.          System.Delete(t,v+1,10);
  149.          move(t,Tabl^[(recs-1)*siz],siz-4);
  150.       end;
  151.    end;
  152. end;
  153.  
  154.  
  155. function dBTabl_Pick_Obj.Choose_dBTabl : boolean;
  156. var
  157.    i,
  158.    l : longint;
  159.    c1: char;
  160.    v : integer;
  161. begin
  162.    AddRec := false;
  163.    if recs > 0 then
  164.       i := GS_Pick_Row_Item(Tabl^,siz,recs, Sel_Item)
  165.    else
  166.    begin
  167.       gotoxy((((lo(WindMax)-lo(WindMin))-4) div 2)+1,
  168.              ((hi(WindMax)-hi(WindMin)) div 2)+1);
  169.       write('Empty');
  170.       repeat
  171.          c1 := GS_KeyI_GetKey;
  172.       until c1 in [#13,#27];
  173.       i := 0;
  174.    end;
  175.    if i > 0 then
  176.    begin
  177.        Choose_dBTabl := true;
  178.        if (AddREcOK) and (i = recs) then
  179.           AddRec := true
  180.        else
  181.        begin
  182.           move(Tabl^[((i-1)*siz)+siz-4],l,4);
  183.           dBas^.GetRec(l);
  184.        end;
  185.        Sel_Item := i;
  186.    end else Choose_dBTabl := false;
  187. end;
  188.  
  189. function dBTabl_Pick_Obj.Pick_dBTabl(zfld : string) : boolean;
  190. var
  191.    t  : string[127];
  192.    v  : integer;
  193.    ta : byte;
  194. begin
  195.    Pick_Win.SetWin;
  196.    AddRec := false;
  197.    zfld := AllCaps(zfld);
  198.    if Scn_Key <> zfld then Reset_dBTabl;
  199.    Scn_Key := zfld;
  200.    if Tabl = nil then
  201.    begin
  202.       gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
  203.               ((hi(WindMax)-hi(WindMin)) div 2)+1);
  204.       ta := TextAttr;
  205.       TextAttr := TextAttr + 128;
  206.       write('Working');
  207.       TextAttr := ta;
  208.       Build_dBTabl(zfld);
  209.    end;
  210.    ClrScr;
  211.    Pick_dBTabl := Choose_dBTabl;
  212.    Pick_Win.RelWin;
  213. end;
  214.  
  215. function dBTabl_Pick_Obj.Find_dBTabl(pcnd : string) : boolean;
  216. var
  217.    recsa,
  218.    i,
  219.    l : longint;
  220.    m,
  221.    s : string;
  222.    mtch : boolean;
  223. begin
  224.    mtch := false;
  225.    m := AllCaps(pcnd);
  226.    recsa := recs;
  227.    if AddRecOK then dec(recsa);
  228.    if recsa > 0 then
  229.    begin
  230.       i := 0;
  231.       repeat
  232.          move(Tabl^[i*siz],s,siz-4);
  233.          s[0] := m[0];
  234.          if (AllCaps(s) = m) then mtch := true;
  235.          inc(i);
  236.       until (i = recsa) or (mtch);
  237.       if not mtch then i := 0;
  238.    end
  239.    else
  240.    begin
  241.       i := 0;
  242.    end;
  243.    if i > 0 then
  244.    begin
  245.        Find_dBTabl := true;
  246.        move(Tabl^[((i-1)*siz)+siz-4],l,4);
  247.        dBas^.GetRec(l);
  248.        Sel_Item := i;
  249.    end else Find_dBTabl := false;
  250. end;
  251.  
  252. function dBTabl_Pick_Obj.FindNext_dBTabl(pcnd : string) : boolean;
  253. var
  254.    recsa,
  255.    i,
  256.    l : longint;
  257.    m,
  258.    s : string;
  259. begin
  260.    recsa := recs;
  261.    if AddRecOK then dec(recsa);
  262.    m := AllCaps(pcnd);
  263.    if (recsa > 0) and (Sel_Item < recsa) then
  264.    begin
  265.       i := Sel_Item;
  266.       move(Tabl^[i*siz],s,siz-4);
  267.       s[0] := m[0];
  268.       inc(i);
  269.       if AllCaps(s) <> m then i := 0;
  270.    end
  271.    else
  272.    begin
  273.       i := 0;
  274.    end;
  275.    if i > 0 then
  276.    begin
  277.        FindNext_dBTabl := true;
  278.        move(Tabl^[((i-1)*siz)+siz-4],l,4);
  279.        dBas^.GetRec(l);
  280.        Sel_Item := i;
  281.    end else FindNext_dBTabl := false;
  282. end;
  283.  
  284. function dBTabl_Pick_Obj.Scan_dBTabl(pfld, pcnd, zfld : string) : boolean;
  285. var
  286.    m,
  287.    s  : string;
  288.    t  : string[127];
  289.    v  : integer;
  290.    ta : byte;
  291.    ia : boolean;
  292.    l  : longint;
  293.    ft : char;
  294. begin
  295.    Pick_Win.SetWin;
  296.    AddRec := false;
  297.    zfld := AllCaps(zfld);
  298.    pfld := AllCaps(pfld);
  299.    Reset_dBTabl;
  300.    Scn_Key := zfld;
  301.    gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
  302.            ((hi(WindMax)-hi(WindMin)) div 2)+1);
  303.    ta := TextAttr;
  304.    TextAttr := TextAttr + 128;
  305.    write('Working');
  306.    TextAttr := ta;
  307.    with dBas^ do
  308.    begin
  309.       ia := dbfNdxActv;
  310.       dbfNdxActv := false;         {Temporarily turn off any index}
  311.       GetRec(Top_Record);
  312.       m := Formula(pfld,ft);
  313.       if m[0] < pcnd[0] then pcnd[0] := m[0];
  314.       m := AllCaps(pcnd);
  315.       t := Formula(zfld,ft);
  316.       l := 0;
  317.       recs := dBas^.NumRecs;
  318.       if AddRecOK then inc(recs);
  319.       siz := length(t) + 5;
  320.       Sz_Tab := recs * siz;
  321.       GetMem(Tabl,Sz_Tab);
  322.       while (not File_EOF) do
  323.       begin
  324.          s := Formula(pfld,ft);
  325.          s[0] := m[0];
  326.          if AllCaps(s) = m then
  327.          begin
  328.             t := Formula(zfld,ft);
  329.             move(t,Tabl^[l*siz],siz-4);
  330.             move(RecNumber,Tabl^[(l*siz)+siz-4],4);
  331.             inc(l)
  332.          end;   ;
  333.          GetRec(Next_Record);
  334.       end;
  335.       dbfNdxActv := ia;
  336.       GetRec(Top_Record);          {Puts DBF and NDX back in sync}
  337.       recs := l;
  338.       GS_Pick_Item_Sort(Tabl^,siz,recs,SortAsnd);
  339.    end;
  340.    if AddRecOK then
  341.    begin
  342.       inc(recs);
  343.       v := siz-5;
  344.       FillChar(t[1],v,' ');
  345.       t[0] := chr(v);
  346.       Insert(ap,t,succ((v - 10) div 2));
  347.       System.Delete(t,v+1,10);
  348.       move(t,Tabl^[(recs-1)*siz],siz-4);
  349.    end;
  350.    ClrScr;
  351.    Scan_dBTabl := Choose_dBTabl;
  352.    Pick_Win.RelWin;
  353. end;
  354.  
  355.  
  356.  
  357. end.
  358.